

Sub OrganizeUnsortedHotels()

    InitializeFolders
    
    Set contactsFolder = GetContactsFolder("Unsorted Hotels")
    
    Dim Contact As ContactItem
    For Each Contact In contactsFolder.Items
        setUserProperty "Hotel Group", Contact.User1, Contact
        setUserProperty "Bedroom Count", Contact.User2, Contact
        setUserProperty "Star Rating", Contact.User3, Contact
        setUserProperty "Region", Contact.User4, Contact
        Contact.Save
        
        Dim RoomCount As Integer
        Dim DestinationFolderName As String
        
        RoomCount = Val(Contact.User2)
        DestinationFolderName = GetFolderName(RoomCount)
        
        MoveContact Contact, DestinationFolderName
    Next
    
    Set Contact = Nothing
    Set contactsFolder = Nothing
End Sub
    
Private Sub setUserProperty(PropertyName As String, PropertyValue As String, Contact As ContactItem)
    Dim property As Outlook.UserProperty
    
    'Find the property if it already exists
    Dim currentProperty As UserProperty
    Dim I As Integer
    For I = 1 To Contact.UserProperties.Count
        Set currentProperty = Contact.UserProperties.Item(I)
        If currentProperty.name = PropertyName Then
            Set property = currentProperty
        End If
    Next
    
    ' otherwise add the property
    If property Is Nothing Then
        Set property = Contact.UserProperties.Add(PropertyName, olText)
    End If
     
     
    property.Value = PropertyValue
End Sub



Private Sub MoveContact(Contact As ContactItem, strDestinationFolder As String)
    Dim destinationFolder As Outlook.MAPIFolder
    Set destinationFolder = GetContactsFolder(strDestinationFolder)
    Contact.Move destinationFolder
End Sub

    
Private Sub InitializeFolders()
    'Set up folders needed
    InitializeFolder (GetFolderName(45))
    InitializeFolder (GetFolderName(35))
    InitializeFolder (GetFolderName(25))
    InitializeFolder (GetFolderName(15))
    InitializeFolder (GetFolderName(5))
End Sub


Public Sub DeleteFolders()
    'Delete folders
    RemoveFolder (GetFolderName(45))
    RemoveFolder (GetFolderName(35))
    RemoveFolder (GetFolderName(25))
    RemoveFolder (GetFolderName(15))
    RemoveFolder (GetFolderName(5))
End Sub

Private Function GetFolderName(RoomCount As Integer) As String
    Dim result As String
    
    If RoomCount > 40 Then
        result = "Hotels Over 40 Rooms"
    ElseIf RoomCount > 30 Then
        result = "Hotels 31 - 40 Rooms"
    ElseIf RoomCount > 20 Then
        result = "Hotels 21 - 30 Rooms"
    ElseIf RoomCount > 10 Then
        result = "Hotels 11 - 20 Rooms"
    Else
        result = "Hotels 10 Rooms or Less"
    End If
    
    GetFolderName = result
End Function

Private Sub RemoveFolder(strFolderName As String)
    Dim contactsFolder As Outlook.MAPIFolder
    Set contactsFolder = GetDefaultContactsFolder()

    'find folder index
    Dim index As Integer
    index = -1
    
    Dim I As Integer
    Dim currentFolder As Outlook.MAPIFolder
    For I = 1 To contactsFolder.Folders.Count
        Set currentFolder = contactsFolder.Folders.Item(I)
        If currentFolder.name = strFolderName Then
            index = I
        End If
    Next
    
    'Remove the folder if it is found
    If index <> -1 Then
        contactsFolder.Folders.Remove index
    End If
End Sub
  
Private Sub InitializeFolder(strFolderName As String)
    Set contactsFolder = GetDefaultContactsFolder()

    'Search for folder to see if it already exists
    Dim destinationFolder As Outlook.MAPIFolder
    Set destinationFolder = GetContactsFolder(strFolderName)
    
    'If it doesn't already exist, create it
    If destinationFolder Is Nothing Then
        Set destinationFolder = contactsFolder.Folders.Add(strFolderName)
    End If
End Sub

Public Function GetDefaultContactsFolder() As MAPIFolder

  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  On Error Resume Next

  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set GetDefaultContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
  
End Function
    
Public Function GetContactsFolder(strFolderPath As String) As MAPIFolder
  ' folder path needs to be something like
  '   "Public Folders\All Public Folders\Company\Sales"
  Dim objApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next

  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")
  Set objApp = CreateObject("Outlook.Application")
  Set objNS = objApp.GetNamespace("MAPI")
  Set contactsFolder = objNS.GetDefaultFolder(olFolderContacts)
  Set objFolder = contactsFolder.Folders(arrFolders(0))
  If Not objFolder Is Nothing Then
    For I = 1 To UBound(arrFolders)
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(I))
      If objFolder Is Nothing Then
        Exit For
      End If
    Next
  End If

  Set GetContactsFolder = objFolder
  Set colFolders = Nothing
  Set objNS = Nothing
  Set objApp = Nothing
End Function


Private Function GetViewDefinition() As String
Dim viewDefinition As String
Dim viewBasics As String
Dim Columns1 As String
Dim Columns2 As String
Dim Columns3 As String
Dim OrderBy As String
Dim endView As String

viewBasics = "<view type=""table"">" & _
"    <viewname>Rathgael Faxer View</viewname>" & _
"    <viewstyle>table-layout:fixed;width:100%;font-family:Tahoma;font-style:normal;font-weight:normal;font-size:8pt;color:Black;font-charset:0</viewstyle>" & _
"    <viewtime>216263427</viewtime>" & _
"    <linecolor>8421504</linecolor>" & _
"    <linestyle>3</linestyle>" & _
"    <gridlines>1</gridlines>" & _
"    <autosizing>0</autosizing>" & _
"    <newitemrow>1</newitemrow>" & _
"    <incelledit>1</incelledit>" & _
"    <usequickflags>0</usequickflags>" & _
"    <collapsestate></collapsestate>" & _
"    <rowstyle>background-color:#FFFFFF</rowstyle>" & _
"    <headerstyle>background-color:#D3D3D3</headerstyle>" & _
"    <previewstyle>color:Blue</previewstyle>" & _
"    <arrangement>" & _
"        <autogroup>0</autogroup>" & _
"        <collapseclient></collapseclient>" & _
"    </arrangement>" & _
"    <multiline>" & _
"        <width>0</width>" & _
"    </multiline>"

Columns1 = "    <column>" & _
"        <name>HREF</name>" & _
"        <prop>DAV:href</prop>" & _
"        <checkbox>1</checkbox>" & _
"    </column>" & _
"    <column>" & _
"        <heading>Icon</heading>" & _
"        <prop>http://schemas.microsoft.com/mapi/proptag/0x0fff0102</prop>" & _
"        <bitmap>1</bitmap>" & _
"        <width>18</width>" & _
"        <style>padding-left:3px;;text-align:center</style>" & _
"    </column>" & _
"    <column>" & _
"        <maxrows>1654128640</maxrows>" & _
"        <heading>Company</heading>" & _
"        <prop>urn:schemas:contacts:o</prop>" & _
"        <type>string</type>" & _
"        <width>100</width>" & _
"        <style>padding-left:3px;;text-align:left</style>" & _
"    </column>"


Columns2 = "    <column>" & _
"        <heading>Region</heading>" & _
"        <prop>http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Region</prop>" & _
"        <type>string</type>" & _
"        <width>50</width>" & _
"        <style>padding-left:3px;;text-align:left</style>" & _
"    </column>" & _
"    <column>" & _
"        <heading>Star Rating</heading>" & _
"        <prop>http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Star%20Rating</prop>" & _
"        <type>string</type>" & _
"        <maxrows>1179648</maxrows>" & _
"        <width>50</width>" & _
"        <style>padding-left:3px;;text-align:left</style>" & _
"    </column>" & _
"    <column>" & _
"        <heading>Bedroom Count</heading>" & _
"        <prop>http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Bedroom%20Count</prop>" & _
"        <type>string</type>" & _
"        <width>50</width>" & _
"        <style>padding-left:3px;;text-align:left</style>" & _
"    </column>"


Columns3 = "    <column>" & _
"        <heading>Hotel Group</heading>" & _
"        <prop>http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Hotel%20Group</prop>" & _
"        <type>string</type>" & _
"        <width>50</width>" & _
"        <style>padding-left:3px;;text-align:left</style>" & _
"    </column>" & _
"    <column>" & _
"        <heading>Full Name</heading>" & _
"        <prop>urn:schemas:contacts:cn</prop>" & _
"        <type>string</type>" & _
"        <width>140</width>" & _
"        <style>padding-left:3px;;text-align:left</style>" & _
"    </column>" & _
"    <column>" & _
"        <heading>Business Fax</heading>" & _
"        <prop>urn:schemas:contacts:facsimiletelephonenumber</prop>" & _
"        <type>string</type>" & _
"        <width>119</width>" & _
"        <style>padding-left:3px;;text-align:left</style>" & _
"    </column>"

OrderBy = "    <orderby>" & _
"        <order>" & _
"            <heading>Country/Region</heading>" & _
"            <prop>urn:schemas:contacts:mailingcountry</prop>" & _
"            <type>string</type>" & _
"            <sort>asc</sort>" & _
"        </order>" & _
"        <order>" & _
"            <heading>Star Rating</heading>" & _
"            <prop>http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Star%20Rating</prop>" & _
"            <type>string</type>" & _
"            <sort>asc</sort>" & _
"        </order>" & _
"        <order>" & _
"            <heading>Bedroom Count</heading>" & _
"            <prop>http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Bedroom%20Count</prop>" & _
"            <type>string</type>" & _
"            <sort>asc</sort>" & _
"        </order>" & _
"    </orderby>" & _
"    <groupbydefault>0</groupbydefault>" & _
"    <previewpane>" & _
"        <markasread>0</markasread>" & _
"    </previewpane>"
endView = "</view>"


viewDefinition = viewBasics & Columns1 & Columns2 & Columns3 & OrderBy & endView
GetViewDefinition = viewDefinition
End Function
